(FILECREATED "29-Sep-78 20:53:46" <LENAT>U.;10 2537   

     changes to:  CHANGE-FAULTEVAL CHANGE-FAULTAPPLY

     previous date: "29-Sep-78 20:44:23" <LENAT>U.;9)


(PRETTYCOMPRINT UCOMS)

(RPAQQ UCOMS [(FNS * UFNS)
	      (P (CHANGE-FAULTEVAL)
		 (CHANGE-FAULTAPPLY))
	      (DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS (ADDVARS (NLAMA NEW-FAULTEVAL)
										    (NLAML])

(RPAQQ UFNS (CHANGE-FAULTEVAL NEW-FAULTEVAL CHANGE-FAULTAPPLY NEW-FAULTAPPLY))
(DEFINEQ

(CHANGE-FAULTEVAL
  [LAMBDA NIL
    (if }(GETD 'ORIG-FAULTEVAL)
	then (PUTD 'ORIG-FAULTEVAL (GETD 'FAULTEVAL)))
    (PUTD 'FAULTEVAL (GETD 'NEW-FAULTEVAL])

(NEW-FAULTEVAL
  [NLAMBDA FAULTX

          (* Allows one to type (CREATOR u) in place of (GETVALUE (QUOTE CREATOR) u), and to type 
	  (CREATOR u f) in place of (GETFIELD f (QUOTE CREATOR) u))


    (SELECTQ (LENGTH FAULTX)
	     (2 UA.ERRNO←NIL
		(if FAULTX:1='CLISP:
		    then (APPLY 'ORIG-FAULTEVAL FAULTX)
		  elseif (GETFIELD 'VALUE FAULTX:1 (EVAL FAULTX:2))
		  elseif UA.ERRNO=NIL
		    then NIL
		  else (APPLY 'ORIG-FAULTEVAL FAULTX)))
	     (3 UA.ERRNO←NIL
		(if FAULTX:1='CLISP:
		    then (APPLY 'ORIG-FAULTEVAL FAULTX)
		  elseif (GETFIELD (EVAL FAULTX:3)
				   FAULTX:1
				   (EVAL FAULTX:2))
		  elseif UA.ERRNO=NIL
		    then NIL
		  else (APPLY 'ORIG-FAULTEVAL FAULTX)))
	     (APPLY 'ORIG-FAULTEVAL FAULTX])

(CHANGE-FAULTAPPLY
  [LAMBDA NIL
    (if }(GETD 'ORIG-FAULTAPPLY)
	then (PUTD 'ORIG-FAULTAPPLY (GETD 'FAULTAPPLY)))
    (PUTD 'FAULTAPPLY (GETD 'NEW-FAULTAPPLY])

(NEW-FAULTAPPLY
  [LAMBDA (FAULTFN FAULTARGS)

          (* Allows one to type (APPLY* s u) in place of (GETVALUE s u), and to type (APPLY* s u f) in place of 
	  (GETVALUE f s u); also works for APPLY)


    (SELECTQ (FLENGTH FAULTARGS)
	     (1 UA.ERRNO←NIL
		(if FAULTFN='CLISP:
		    then (ORIG-FAULTAPPLY FAULTFN FAULTARGS)
		  elseif (GETFIELD 'VALUE FAULTFN FAULTARGS:1)
		  elseif UA.ERRNO=NIL
		    then NIL
		  else (ORIG-FAULTAPPLY FAULTFN FAULTARGS)))
	     (2 UA.ERRNO←NIL
		(if FAULTFN='CLISP:
		    then (ORIG-FAULTAPPLY FAULTFN FAULTARGS)
		  elseif (GETFIELD FAULTARGS:2 FAULTFN FAULTARGS:1)
		  elseif UA.ERRNO=NIL
		    then NIL
		  else (ORIG-FAULTAPPLY FAULTFN FAULTARGS)))
	     (ORIG-FAULTAPPLY FAULTFN FAULTARGS])
)
(CHANGE-FAULTEVAL)
(CHANGE-FAULTAPPLY)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS 

(ADDTOVAR NLAMA NEW-FAULTEVAL)

(ADDTOVAR NLAML )
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (488 2351 (CHANGE-FAULTEVAL 500 . 659) (NEW-FAULTEVAL 663 . 1416) (CHANGE-FAULTAPPLY 1420 . 1585) (NEW-FAULTAPPLY
1589 . 2348)))))
STOP